home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / libs / intuisup.lha / Intuisup / Library / M2AmigaModula / IntuisupDemo.mod < prev    next >
Text File  |  1992-08-16  |  31KB  |  713 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       IntuisupDemo
  3.   :Contents.      Demonstrates use of Torsten Jürgeleits intuisup.library
  4.   :Author.        Johann Semsrott
  5.   :Address.       Märkerweg 50d
  6.   :Address.       D-2000 Hamburg 61 (Germany)
  7.   :Address.       Tel.: 040/552 37 83
  8.   :History.       v1.1 16-Aug-92
  9.   :Copyright.     Freeware
  10.   :Language.      Modula
  11.   :Translator.    M2Amiga V4.0d
  12.   :Imports.       intuisup
  13.   :Remark.        Thanks to Torsten for his great library
  14.   :Bugs.          ?
  15. ------------------------------------------------------------------------ *)
  16.  
  17. MODULE IntuisupDemo;
  18.  
  19. FROM Arts         IMPORT  BreakPoint,Assert;
  20. FROM SYSTEM       IMPORT  ADDRESS,ADR,CAST,ASSEMBLE,BITSET;
  21. FROM Call         IMPORT  Return;
  22. FROM ExecD        IMPORT  List,ListPtr,Node,NodePtr,MemReqs,MemReqSet;
  23. FROM ExecL        IMPORT  AllocMem,AddTail,Remove,FreeMem,RemHead,WaitPort;
  24. FROM String       IMPORT  Concat;
  25. FROM DiskFontL    IMPORT  OpenDiskFont;
  26. FROM DosL         IMPORT  Delay;
  27. FROM ExecSupport  IMPORT  NewList;
  28. FROM GraphicsD    IMPORT  TextAttr,TextAttrPtr,TextFontPtr,FontFlagSet,FontFlags,FontStyles,FontStyleSet;
  29. FROM IntuitionL   IMPORT  SetWindowTitles,DisplayBeep,EndRefresh,BeginRefresh; 
  30. FROM IntuitionD   IMPORT  IDCMPFlags,IDCMPFlagSet,Image,MenuItemPtr,
  31.                           WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet,
  32.                           IntuiMessagePtr,GadgetPtr,NewWindow,WindowPtr;
  33. FROM intuisupD    IMPORT  Button,Check,MX,String,Integer,Slider,Scroller,Cycle,Count,Listview,Palette, 
  34.                           RenderInfoPtr,RenderInfoFlags,RenderInfoFlagSet,
  35.                           ConvertFlagSet,ConvertFlags,
  36.                           ClrWindowFlags,ClrWindowFlagSet,
  37.                           RWindowFlags,RWindowFlagSet,
  38.                           BorderData,
  39.                           GadgetData,GadgetDataPtr,GadgetDataFlags,GadgetDataFlagSet,
  40.                           GadgetListPtr,ISUP,curValue,dtText,
  41.                           TextDataFlagSet,TextDataFlags,
  42.                           MenuListPtr,MenuData,MenuDataFlagSet,MenuDataFlags,
  43.                           AutoRequesterFlags,AutoRequesterFlagSet;
  44.  
  45. FROM intuisupL    IMPORT  IGetRenderInfo,IFreeRenderInfo,IDrawBorder,
  46.                           IConvertUnsignedDec,IConvertSignedDec,IConvertBin,IConvertHex,
  47.                           IPrintText,
  48.                           IOpenWindow,ICloseWindow,IClearWindow,IDisplayBorders,
  49.                           ICreateGadgets,IDisplayGadgets,IRemoveGadgets,IFreeGadgets,IRefreshGadgets,
  50.                           ISetGadgetAttributes,
  51.                           IGadgetAddress,IGetMsg,IReplyMsg,
  52.                           ICreateMenu,IAttachMenu,IMenuItemAddress,IRemoveMenu,
  53.                           IFreeMenu,
  54.                           IBuildLanguageTextArray,IFreeLanguageTextArray,
  55.                           IAutoRequest;
  56.  
  57. CONST lButton = 068H; rButton = 069H;
  58.       Winwidth= 620;  Winheight=250;
  59.       msgLE= 0;       msgHE=8;      msgTE=Winheight-msgHE-5;    msgWI=Winwidth; 
  60.       gadgets=50;     noFlag=GadgetDataFlagSet{};
  61.     
  62. TYPE  border=RECORD
  63.         LE,TE,WI,HE:INTEGER;
  64.       END;
  65.     
  66.   strPtr=POINTER TO ARRAY [0..79] OF CHAR;
  67. VAR
  68.   nw        :NewWindow;
  69.   WinPtr    :WindowPtr;
  70.   riPtr     :RenderInfoPtr;
  71.   glPtr     :GadgetListPtr;
  72.   mlPtr     :MenuListPtr;
  73.   gd        :ARRAY [0..gadgets] OF GadgetData;
  74.   bd        :ARRAY [0..gadgets] OF border;
  75.   text      :ARRAY [0..gadgets+1] OF ADDRESS;
  76.   gdFLAGS   :ARRAY [0..gadgets] OF GadgetDataFlagSet;
  77.   gdNOFLAGS :ARRAY [0..gadgets] OF GadgetDataFlagSet;
  78.   md        :ARRAY [1..18] OF MenuData;
  79.   stFlags,textFlags   :GadgetDataFlagSet;
  80.   gdf       :GadgetDataFlags;
  81.   class     :IDCMPFlagSet;
  82.   buffer,nr :ARRAY [0..79] OF CHAR;
  83.   mx        :ARRAY [0..12] OF LONGINT;
  84.   ltaptr,lta:ARRAY [0..2] OF ADDRESS;
  85.   clrmodus  :ClrWindowFlagSet;
  86.   TitleList :List;
  87.   titlePtr  :ListPtr;
  88.   buf       :strPtr;
  89.   img       :ARRAY [1..4] OF Image;
  90.   count     :BOOLEAN;
  91.   ThinAttr  :TextAttr;
  92.   ThinFont  :TextFontPtr;
  93.   j         :ADDRESS;
  94.   iptr      :MenuItemPtr;
  95.   Value,n,n0,FLAGS:LONGCARD;
  96.   value,nr1,nr2   :LONGINT;
  97.   code,Menu,Item,SubItem,menuPen,aktivGadget,index  :CARDINAL;
  98.   mouseX,mouseY,entries,language,i,countmode            :INTEGER;
  99.   
  100. (*$ EntryExitCode:=FALSE *)
  101. PROCEDURE startDat;       (* Imagedaten für Gadget 15 (normal image) *)
  102.  
  103. BEGIN
  104.    (* Plane 1 *)
  105.    ASSEMBLE (DC.W  $FFFF, $FF00, $8000, $0100, $8060, $0100, $8078, $0100 END);
  106.    ASSEMBLE (DC.W  $807E, $0100, $807F, $8100, $807E, $0100, $8078, $0100 END);
  107.    ASSEMBLE (DC.W  $8060, $0100, $8000, $0100, $8000, $0100, $FFFF, $FF00 END);
  108.    (* Plane 2 *)
  109.    ASSEMBLE (DC.W  $0000, $0000, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
  110.    ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
  111.    ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $0000, $0000 END);
  112. END startDat;
  113.  
  114. (*$ EntryExitCode:=FALSE *)
  115. PROCEDURE stopDat;        (* Imagedaten für Gadget 15 (select image) *)
  116.  
  117. BEGIN
  118.    (* Plane 1 *)
  119.    ASSEMBLE (DC.W  $FFFF, $FF00, $8000, $0100, $8000, $0100, $80FE, $0100 END);
  120.    ASSEMBLE (DC.W  $80FE, $0100, $80FE, $0100, $80FE, $0100, $80FE, $0100 END);
  121.    ASSEMBLE (DC.W  $80FE, $0100, $8000, $0100, $8000, $0100, $FFFF, $FF00 END);
  122.    (* Plane 2 *)
  123.    ASSEMBLE (DC.W  $0000, $0000, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
  124.    ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
  125.    ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $0000, $0000 END);
  126. END stopDat;
  127.  
  128. (*$ EntryExitCode:=FALSE *)
  129. PROCEDURE knobhDat;       (* Imagedaten für Gadget 8 (horiz. slider knob) *)
  130. BEGIN
  131.    (* Plane 1 *)
  132.    ASSEMBLE (DC.W  $0400, $0E00, $0E00, $6EC0, $9F20, $9F20, $6EC0, $0E00 END);
  133.    ASSEMBLE (DC.W  $0E00, $0400 END);
  134. END knobhDat;
  135.  
  136. (*$ EntryExitCode:=FALSE *)
  137. PROCEDURE knobvDat;       (* Imagedaten für Gadget 10 (vert. slider knob) *)
  138. BEGIN
  139.    (* Plane 1 *)
  140.    ASSEMBLE (DC.W  $1800, $2400, $2400, $1800, $7E00, $FF00, $7E00, $1800 END);
  141.    ASSEMBLE (DC.W  $2400, $2400, $1800 END);
  142. END knobvDat;
  143.  
  144. PROCEDURE InitIMAGES;
  145. VAR i:  INTEGER;
  146. BEGIN
  147.   FOR i:=1 TO 4 DO
  148.     WITH img[i] DO
  149.       leftEdge  := 0;
  150.       topEdge   := 0;
  151.       IF i<3 THEN depth:= 2;planePick := 3;
  152.              ELSE depth:=1;planePick  := 1;END; 
  153.       planeOnOff  := 0;
  154.       nextImage := NIL;
  155.       CASE i OF
  156.         1:imageData:=ADR(startDat);height:=12;width:=24;|
  157.         2:imageData:=ADR(stopDat);height:=12;width:=24;|
  158.         3:imageData:=ADR(knobhDat);height:=10;width:=11;|
  159.         4:imageData:=ADR(knobvDat);height:=11;width:=8;|
  160.       END;
  161.     END;
  162.   END;
  163. END InitIMAGES;
  164.  
  165. PROCEDURE SetRequester; (* erzeugt einen AutoRequest, *)
  166. VAR lang  :ADDRESS; (* die darzustellenden Texte werden aus einer LANGUAGE-Datei ge-*)
  167. BEGIN               (* laden; die Nummern 61..64 geben den Offset ab Dateianfang an *)
  168.   lang:=lta[language];
  169.   IF IAutoRequest (WinPtr,61,62,63,64,IDCMPFlagSet{diskInserted},IDCMPFlagSet{},
  170.            AutoRequesterFlagSet{rbackFill,rtextCenter,rhotkey,rbeep,rmovePointerPos,
  171.            rdrawRaster},lang)
  172.   THEN END;
  173. (*  IF IAutoRequest (WinPtr,ADR("Auto-Requester"),
  174.             ADR("Testzeile 1\\n\\nTestzeile 2\\nTestzeile 3\\n\\nTestzeile 4"),
  175.             ADR("_OK!"),ADR("_Nein!"),IDCMPFlagSet{diskInserted},IDCMPFlagSet{},
  176.             AutoRequesterFlagSet{rbackFill,rtextCenter,rhotkey,rbeep,rmovePointerPos,rdrawRaster},
  177.             NIL)
  178.   THEN END;*)   (* Alternative: Texte sind fest vorgegeben *)
  179. END SetRequester;
  180.  
  181. PROCEDURE OpenThinFont():BOOLEAN;       (* schmalen Font für Gadget 5 laden *)
  182. BEGIN
  183.   WITH ThinAttr DO
  184.     name:=ADR("thin609.font");
  185.     ySize:=8;
  186.     flags:=FontFlagSet{diskFont};
  187.     style:=FontStyleSet{};
  188.   END;
  189.   ThinFont:=OpenDiskFont(ADR(ThinAttr));
  190.   IF ThinFont=NIL THEN  (* falls nicht gefunden, Requester bringen *)
  191.     RETURN IAutoRequest (WinPtr,ADR("Auto- Requester"),
  192.           ADR("Font\\n\\nThin609\\n\\nist nicht vorhanden.\\n\\nMit topaz weitermachen?"),
  193.           ADR("_Ja!"),ADR("_Nein"),IDCMPFlagSet{},IDCMPFlagSet{},
  194.           AutoRequesterFlagSet{rbackFill,rtextCenter,rhotkey,rbeep,rmovePointerPos,rdrawRaster},
  195.           NIL);
  196.   END;
  197.   RETURN TRUE;
  198. END OpenThinFont;
  199.  
  200. PROCEDURE FreeTestList;   (* Liste (z.B. für ein ListView-Gadget) wieder freigeben *)
  201. VAR node  :NodePtr;
  202. BEGIN
  203.   node:=RemHead(titlePtr);
  204.   WHILE node#NIL DO
  205.     FreeMem(node,SIZE(Node));
  206.     node:=RemHead(titlePtr);
  207.   END;
  208. END FreeTestList;
  209.  
  210. PROCEDURE BuildTestList():BOOLEAN;  (* Liste für ein ListView-Gadget aufbauen *)
  211. VAR t   :POINTER TO ADDRESS;  (* Das gdNOFLAGS-Array enthält die für den *)
  212.   node  :NodePtr;             (* jeweiligen Gadgettyp relevanten Flags *)
  213. BEGIN
  214.   stFlags:=GadgetDataFlagSet{disabled,noBorder,highComp,hotKey,noText,gdcolor2,movePointer,noClear};
  215.   textFlags:=GadgetDataFlagSet{textLeft,textRight,textAbove,textBelow};
  216.   text[0]:=ADR("Button");             gdNOFLAGS[0]:=stFlags+textFlags+GadgetDataFlagSet{buttonToggle};                                     
  217.   text[1]:=ADR("\001Button (toggle)");gdNOFLAGS[1]:=stFlags+textFlags+GadgetDataFlagSet{buttonToggle};                                     
  218.   text[2]:=ADR("\001Button (Image)"); gdNOFLAGS[2]:=stFlags+textFlags+GadgetDataFlagSet{buttonToggle,buttonImage};                                     
  219.   text[3]:=ADR("Check");              gdNOFLAGS[3]:=stFlags+textFlags;                                                                                 
  220.   text[4]:=ADR("Mutual Exclude");     gdNOFLAGS[4]:=stFlags+GadgetDataFlagSet{textLeft,textRight};                                                                                 
  221.   text[5]:=ADR("String");             gdNOFLAGS[5]:=stFlags+textFlags+GadgetDataFlagSet{autoActivate,inputCenter,inputRight};                          
  222.   text[6]:=ADR("Integer");            gdNOFLAGS[6]:=stFlags+textFlags+GadgetDataFlagSet{autoActivate,inputCenter,inputRight,unsignDec,signDec,hex,bin};
  223.   text[7]:=ADR("Integer");            gdNOFLAGS[7]:=stFlags+textFlags+GadgetDataFlagSet{autoActivate,inputCenter,inputRight,unsignDec,signDec,hex,bin};
  224.   text[8]:=ADR("Slider (horiz.)");    gdNOFLAGS[8]:=stFlags+textFlags+GadgetDataFlagSet{sliderImage,vertOrient};                                                  
  225.   text[9]:=ADR("Scroller (horiz.)");  gdNOFLAGS[9]:=stFlags+textFlags+GadgetDataFlagSet{noArrows,vertOrient};                                         
  226.   text[10]:=ADR("Slider (vert.)");    gdNOFLAGS[10]:=stFlags+textFlags+GadgetDataFlagSet{sliderImage,vertOrient};                                                 
  227.   text[11]:=ADR("Scroller (vert.)");  gdNOFLAGS[11]:=stFlags+textFlags+GadgetDataFlagSet{noArrows,vertOrient};                                        
  228.   text[12]:=ADR("Cycle");             gdNOFLAGS[12]:=stFlags+textFlags;                                                                                
  229.   text[13]:=ADR("\001Cycle (hiComp)");gdNOFLAGS[13]:=stFlags+textFlags;                                                                                
  230.   text[14]:=ADR("Count");             gdNOFLAGS[14]:=stFlags+textFlags+GadgetDataFlagSet{countSignDec};                                                
  231.   text[15]:=ADR("Listview");          gdNOFLAGS[15]:=stFlags+GadgetDataFlagSet{readOnly,showSelected,listViewColor};                         
  232.   text[16]:=ADR("Palette");           gdNOFLAGS[16]:=stFlags+GadgetDataFlagSet{noIndicator,indicatorTop};                                    
  233.   t:=ADR(text[0]);
  234.           (* benötigt wird jeweils ein Zeiger auf den Anfang eines darzustel- *)
  235.           (* lenden Strings; das Ende der Liste wird durch NIL gekennzeichnet.*)
  236.           (* Da die Arrayelemente hintereinanderliegen und automatisch mit '0'*)
  237.           (* vorbesetzt sind, braucht man nur ein Element mehr als Strings    *)
  238.           (* vorhanden sind zu deklarieren. *)
  239.   titlePtr:=ADR(TitleList);
  240.   NewList(titlePtr);                      (* Listenkopf einrichten *)
  241.   WHILE t^#NIL DO 
  242.     node:=AllocMem(SIZE(Node),MemReqSet{public,memClear});  (* Speicher reservieren *)
  243.     IF node #NIL THEN
  244.       node^.name:=t^;         (* Adresse in Knoten eintragen *)
  245.       AddTail(titlePtr,node); (* Knoten am Ende der Liste anfügen *)
  246.       INC(t,4);
  247.     ELSE
  248.       FreeTestList;           (* unvollständige Liste wieder entfernen *)
  249.       Assert(node#NIL,ADR("Speichermangel!"));
  250.       RETURN FALSE;
  251.     END;
  252.   END;
  253.   RETURN TRUE;
  254. END BuildTestList;
  255.  
  256. PROCEDURE GetIMes(WinPtr:WindowPtr; VAR code:CARDINAL;
  257.                   VAR value:LONGINT;
  258.                   VAR class:IDCMPFlagSet):BOOLEAN;
  259. VAR msg :IntuiMessagePtr;
  260. BEGIN
  261.   msg:=IGetMsg(WinPtr^.userPort);
  262.   IF msg#NIL THEN
  263.     code:=msg^.code;
  264.     value:=msg^.iAddress;
  265.     class:=msg^.class;
  266.     mouseX:=msg^.mouseX;
  267.     mouseY:=msg^.mouseY;
  268.     IReplyMsg(msg);
  269.     IF ISUP=class THEN RETURN TRUE;   (* Ausstieg, wenn intuisup-Meldung vorliegt *)
  270. (*    ELSIF (closeWindow IN class)  THEN value :=1000;  
  271.       ELSIF (rawKey IN class)       THEN value := -2;
  272.       ELSIF (vanillaKey IN class)   THEN value := -3;
  273.       ELSIF (mouseMove IN class)    THEN value := -4;
  274.       ELSIF (newSize IN class)      THEN value := 997;
  275.       ELSIF (mouseButtons IN class) THEN
  276.         IF code=lButton THEN value:=999; END;
  277.         IF code=rButton THEN value:=998; END;
  278.       ELSIF (intuiTicks IN class)   THEN RETURN FALSE;*)
  279.     END;
  280.   END;
  281.   RETURN (msg#NIL);(* Ausstieg, wenn keine oder eine Standard-IDCMP-Meldung vorliegt *)
  282. END GetIMes;
  283.  
  284.  
  285. PROCEDURE ModifyMenuList(opt:INTEGER);(* opt:   Wirkung: *)
  286. VAR ltptr   :ADDRESS;                 (* 0  Menu wird entfernt, Speicher wieder freigegeben *)
  287. BEGIN                                 (* 1  wie 0, dann: Menu wird neu kreiiert *)
  288.   IF opt<2 THEN                       (* 2  Menu wird erstmalig kreiiert *)
  289.     IF mlPtr#NIL THEN
  290.       WinPtr:=IRemoveMenu(mlPtr);
  291.       IFreeMenu(mlPtr);
  292.     END;
  293.   END;
  294.   IF opt>0 THEN
  295.     ltptr:=lta[language];   (* ltptr: Zeiger auf die sprachenspez. Textdatei *)
  296.     mlPtr:=ICreateMenu(riPtr,WinPtr,ADR(md[1]),NIL,ltptr);
  297.     IF mlPtr#NIL THEN
  298.       INC(menuPen);mlPtr^.mlTextPen1:=menuPen;mlPtr^.mlTextPen2:=1;
  299.       IAttachMenu(WinPtr,mlPtr);
  300.     ELSE Assert(mlPtr#NIL,ADR("No Menulist found!"));
  301.     END;
  302.   END;
  303. END ModifyMenuList;
  304.  
  305. PROCEDURE ModifyGadgetList(opt:INTEGER);  (* siehe ModifyMenuList *)
  306. VAR ltptr   :ADDRESS;
  307. BEGIN
  308.   IF opt<2 THEN
  309.     IF glPtr#NIL THEN
  310.       IRemoveGadgets(glPtr);
  311.       IFreeGadgets(glPtr);
  312.       IClearWindow(riPtr,WinPtr,0,0,Winwidth,Winheight,clrmodus);
  313.     END;
  314.   END;
  315.   IF opt>0 THEN
  316.     glPtr:=ICreateGadgets(riPtr,ADR(gd[0]),2,4,lta[language]);
  317.     IF glPtr#NIL THEN IDisplayGadgets(WinPtr,glPtr);
  318.                  ELSE Assert(glPtr#NIL,ADR("No Gadgetlist found!"));
  319.     END;
  320.   END;
  321. END ModifyGadgetList;
  322.  
  323. PROCEDURE Setmd(Type,sel:INTEGER;key:BOOLEAN;mu:LONGCARD);
  324. BEGIN       (* zum bequemeren Füllen der MenuData-Records *)
  325.   WITH md[i] DO
  326.     mdType:=Type;
  327.     CASE sel OF
  328.       0:mdFlags:=MenuDataFlagSet{};|
  329.       1:mdFlags:=MenuDataFlagSet{attribute};|
  330.       2:mdFlags:=MenuDataFlagSet{emptyLine};|
  331.       3:mdFlags:=MenuDataFlagSet{attribute,selected};|
  332.       4:mdFlags:=MenuDataFlagSet{highNone};|
  333.       5:mdFlags:=MenuDataFlagSet{highBox};|
  334.       6:mdFlags:=MenuDataFlagSet{mdColor2};|
  335.       7:mdFlags:=MenuDataFlagSet{Disabled};|
  336.       ELSE
  337.     END;
  338.     mdText:=j;                (* Offset in LANGUAGE-Textdatei *)
  339.     IF key THEN
  340.       INC(j);mdCommandKey:=j; (* Shortcut aus der nächsten Zeile  *)
  341.     ELSE                      (* der LANGUAGE-Textdatei holen *)
  342.       mdCommandKey:=NIL;
  343.     END;
  344.     mdMutualExclude :=mu; (* falls mu#0 werden die Items/SubItems, für die ein *)
  345.                           (* Bit gesetzt ist, bei Anwahl dieses Items/SubItems *)
  346.                           (* deselektiert *)
  347.   END;
  348.   INC(i); (* zum nächsten ARRAY-Element weiterschalten *)
  349.   INC(j); (* Offset in LANGUAGE-Textdatei weiterschalten *)
  350. END Setmd;
  351.  
  352. PROCEDURE InitMenu;
  353. BEGIN
  354.   i:=1;                 (* mit ARRAY-Element 1 beginnen *)
  355.   j:=65;                (* Offset für ersten Text in LANGUAGE-Textdatei ist 65 *)
  356.   Setmd(1,0,FALSE,0);   (* Menu 0 *)
  357.   Setmd(2,3,TRUE,510);  (* Item 0.0 *)
  358.   Setmd(2,1,TRUE,509);  (* Item 0.1 *)
  359.   Setmd(2,4,FALSE,0);   (* Item 0.2 *)
  360.   Setmd(3,0,TRUE,0);    (* Item 0.2.0 *)
  361.   Setmd(3,0,TRUE,0);    (* Item 0.2.1 *)
  362.   Setmd(2,5,FALSE,0);   (* Item 0.3 *)
  363.   Setmd(1,0,FALSE,0);   (* Menu 1 *)
  364.   Setmd(2,1,TRUE,0);    (* Item 1.0 *)
  365.   Setmd(2,2,TRUE,0);    (* Item 1.1 *)
  366.   Setmd(2,0,FALSE,0);   (* Item 1.2 *)
  367.   Setmd(3,0,TRUE,0);    (* Item 1.2.0 *)
  368.   Setmd(3,6,TRUE,0);    (* Item 1.2.1 *)
  369.   Setmd(2,0,FALSE,0);   (* Item 1.3 *)
  370.   Setmd(3,0,TRUE,0);    (* Item 1.3.0 *)
  371.   Setmd(3,7,TRUE,0);    (* Item 1.3.1 *)
  372.   Setmd(2,5,TRUE,0);    (* Item 1.4 *)
  373.   ModifyMenuList(2);    (* Menüs erstmalig einrichten/anzeigen *)
  374. END InitMenu;
  375.  
  376. PROCEDURE SetDefaultFlags;
  377. BEGIN
  378.   gdFLAGS[0]:=GadgetDataFlagSet{hotKey};
  379.   gdFLAGS[1]:=GadgetDataFlagSet{hotKey,buttonToggle};
  380.   gdFLAGS[2]:=GadgetDataFlagSet{hotKey,buttonToggle,buttonImage,textAbove,noBorder};
  381.   gdFLAGS[3]:=GadgetDataFlagSet{hotKey,textRight};
  382.   gdFLAGS[4]:=GadgetDataFlagSet{hotKey,textLeft};
  383.   gdFLAGS[5]:=GadgetDataFlagSet{autoActivate,hotKey,textLeft};
  384.   gdFLAGS[6]:=GadgetDataFlagSet{autoActivate,hotKey,signDec,textLeft};
  385.   gdFLAGS[7]:=GadgetDataFlagSet{autoActivate,hotKey,signDec,textLeft};
  386.   gdFLAGS[8]:=GadgetDataFlagSet{hotKey,gdcolor2,textAbove};
  387.   gdFLAGS[9]:=GadgetDataFlagSet{hotKey,gdcolor2,textAbove};
  388.   gdFLAGS[10]:=GadgetDataFlagSet{hotKey,gdcolor2,vertOrient,textLeft};
  389.   gdFLAGS[11]:=GadgetDataFlagSet{hotKey,gdcolor2,vertOrient,textRight};
  390.   gdFLAGS[12]:=GadgetDataFlagSet{hotKey,textAbove};
  391.   gdFLAGS[13]:=GadgetDataFlagSet{hotKey,highComp,textAbove};
  392.   gdFLAGS[14]:=GadgetDataFlagSet{hotKey,textLeft};
  393.   gdFLAGS[15]:=GadgetDataFlagSet{hotKey,textAbove,showSelected,listViewColor};
  394.   gdFLAGS[16]:=GadgetDataFlagSet{hotKey,indicatorTop,textAbove};
  395.   FOR i:=0 TO 31 DO
  396.     gdFLAGS[17+i]:=GadgetDataFlagSet{buttonToggle};
  397.   END;
  398.   gdFLAGS[49]:=GadgetDataFlagSet{hotKey,gdcolor2};
  399. END SetDefaultFlags;
  400.  
  401. PROCEDURE SetGadgets(type:LONGINT;le,te,wi,he:INTEGER;ta:TextAttrPtr;
  402.                      l1,l2,l3:LONGINT);
  403. BEGIN       (* zum bequemeren Füllen der GadgetData-Records *)
  404.   WITH gd[index] DO
  405.     gdType    :=type;
  406.     gdFlags   :=gdFLAGS[index];
  407.     gdLeftEdge:=le;
  408.     gdTopEdge :=te;
  409.     gdWidth   :=wi;
  410.     gdHeight  :=he;
  411.     gdText    :=index+1;  (* Offset in LANGUAGE-Textdatei, Offset beginnt *)
  412.     gdTextAttr:=ta;       (* mit 1, Array-Index aber mit 0 *)
  413.     gdData1   :=l1;
  414.     gdData2   :=l2;
  415.     gdData3   :=l3;
  416.   END;
  417.   WITH bd[index] DO (* wird benötigt, um später bei Auswahl per Listview- *)
  418.     LE:=le-3;TE:=te;WI:=wi+10;HE:=he+6; (* <---- Rahmenkoordinaten *) 
  419.   END;              (* Gadget dieses mit einem wechseln Rahmen zu umgeben *)
  420.   INC(index); (* zum nächsten Array-Element weiterschalten *) 
  421. END SetGadgets;
  422.  
  423. PROCEDURE SetStringGadgets(type:LONGINT;le,te,wi,he:INTEGER;ta:TextAttrPtr;
  424.                            l1:LONGINT;l2,l3:INTEGER;l4:ADDRESS);
  425. BEGIN (* zum bequemeren Füllen der GadgetData-Records *)
  426.   WITH gd[index] DO
  427.     gdType    :=type;
  428.     gdFlags   :=gdFLAGS[index];
  429.     gdLeftEdge:=le;
  430.     gdTopEdge :=te;
  431.     gdWidth   :=wi;
  432.     gdHeight  :=he;
  433.     gdText    :=index+1;
  434.     gdTextAttr:=ta;
  435.     gdInputLen:=l1;
  436.     gdInputActivateNext:=l2;
  437.     gdInputActivatePrev:=l3;
  438.     gdInputDefault:=l4;
  439.   END;
  440.   WITH bd[index] DO
  441.     LE:=le-3;TE:=te;WI:=wi+10;HE:=he+6;
  442.   END;
  443.   INC(index);
  444. END SetStringGadgets;
  445.  
  446. PROCEDURE SetTestGadgets;
  447. BEGIN
  448.   index:=0;
  449.   SetGadgets(Button,150,84,120,14,NIL,0,0,0);
  450.   SetGadgets(Button,484,135,116,14,NIL,0,0,0);
  451.   SetGadgets(Button,530,80,24,14,NIL,0,ADR(img[1]),ADR(img[2]));
  452.   SetGadgets(Check,240,10,20,14,NIL,0,0,0);
  453.   SetGadgets(MX,10,10,130,42,NIL,2,0,ADR(mx[0]));
  454.   SetStringGadgets(String,360,30,146,14,NIL,40,7,8,ADR("Library-Test"));
  455.   SetStringGadgets(Integer,360,48,48,14,NIL,6,8,6,nr1);
  456.   SetStringGadgets(Integer,360,66,48,14,NIL,6,6,7,nr2);
  457.   SetGadgets(Slider,420,180,140,14,ADR(img[3]),-10,10,0);
  458.   SetGadgets(Scroller,420,210,140,14,NIL,4,20,8);
  459.   SetGadgets(Slider,440,50,14,110,ADR(img[4]),-20,20,0);
  460.   SetGadgets(Scroller,460,50,14,110,NIL,2,40,8);
  461.   SetGadgets(Cycle,420,10,86,14,NIL,2,0,ADR(mx[4]));
  462.   SetGadgets(Cycle,484,50,116,14,NIL,2,0,ADR(mx[9]));
  463.   SetGadgets(Count,360,84,60,14,NIL,nr1,nr2,(nr1+nr2) DIV 2);
  464.   SetGadgets(Listview,10,68,130,50,ADR(ThinAttr),0,aktivGadget,ADR(TitleList));
  465.   SetGadgets(Palette,150,10,80,72,NIL,3,0,1);
  466. END SetTestGadgets;
  467.  
  468. PROCEDURE InitGadgets;
  469. VAR i:  INTEGER;
  470. BEGIN
  471.   mx[0]:=51; mx[1]:=52; (* Offsets in LANGUAGE-Textdatei; dort stehen die Texte *)
  472.   mx[2]:=53;            (* für das Mutual-Exclude-Gadget (Gadget 4) *)
  473.   mx[3]:=0;             (* Ende-Markierung für MX-Texte *)
  474.   mx[4]:=54; mx[5]:=55; (* Offsets in LANGUAGE-Textdatei; dort stehen die Texte *)
  475.   mx[6]:=56; mx[7]:=57; (* für das Cycle-Gadget (Gadget 12) *)
  476.   mx[8]:=0;             (* Ende-Markierung für Cycle-Texte *)
  477.   mx[9]:=58; mx[10]:=59;(* desgl. für Cycle-Gadget 13 *)
  478.   mx[11]:=60; mx[12]:=0;
  479.   nr1:=600;nr2:=620;
  480.   InitIMAGES;           (* Grafiken für Gadget 14 initialisieren *) 
  481.   SetTestGadgets;
  482.   FOR i:=0 TO 31 DO (* Gadgets zum Verändern der Flags der Testgadgets *)
  483.     SetGadgets(Button,10+(i DIV 8)*95,116+(i MOD 8)*14,88,14,ADR(ThinAttr),0,0,0);
  484.   END;
  485.   SetGadgets(Button,150,100,180,14,NIL,0,0,0);
  486.   (* gd[gadgets] bleibt leer (ist mit '0'en vorbesetzt) und dient daher als Abschluß *)
  487.   (* der Gadgetliste *)
  488.   ModifyGadgetList(2);  (* Gadgets erstmalig einrichten *)
  489. END InitGadgets;
  490.  
  491. PROCEDURE InitWindow; (* Fenster öffnen *)
  492. BEGIN
  493.   WITH nw DO
  494.     leftEdge :=0; topEdge :=50; width := Winwidth; height:=Winheight;
  495.     type :=ScreenFlagSet{wbenchScreen};
  496.     title:=ADR("Library-Test");
  497.     idcmpFlags := IDCMPFlagSet {closeWindow,gadgetUp,gadgetDown,mouseButtons,
  498.                                 mouseMove,intuiTicks,vanillaKey,menuPick,newSize};
  499.     flags := WindowFlagSet {windowClose,windowDrag, windowDepth,reportMouse,
  500.                             windowSizing,activate};
  501.     minWidth := 40; maxWidth := 640; minHeight :=40; maxHeight :=480;
  502.   END;
  503.   riPtr:=IGetRenderInfo(NIL,RenderInfoFlagSet{innerWindow});
  504.   IF riPtr#NIL THEN 
  505.     WinPtr:=IOpenWindow(riPtr,ADR(nw),RWindowFlagSet{renderPens,centerWindow})
  506.   ELSE
  507.     Assert(riPtr#NIL,ADR("Got no RenderInfo!"));
  508.   END;
  509. END InitWindow;
  510.  
  511. PROCEDURE CloseAll;
  512. VAR i:  INTEGER;
  513. BEGIN
  514.   ModifyGadgetList(0);    (* Gadgets entfernen *)
  515.   IF riPtr#NIL THEN
  516.     IFreeRenderInfo(riPtr); 
  517.   END;
  518.   ModifyMenuList(0);      (* Menüleiste entfernen *)
  519.   IF WinPtr#NIL THEN ICloseWindow(WinPtr,FALSE);END;
  520.   WinPtr:=NIL;
  521.   FOR i:=0 TO 2 DO
  522.     IF lta[i]#NIL THEN IFreeLanguageTextArray(lta[i]);END;
  523.   END;
  524.   FreeTestList;
  525. END CloseAll;
  526.  
  527. PROCEDURE SetTextArray;     (* LANGUAGE-Datei öffnen *) 
  528. BEGIN
  529.   IF lta[language]=NIL THEN
  530.     lta[language]:=IBuildLanguageTextArray(ltaptr[language],entries);
  531.     IF lta[language]=NIL THEN CloseAll;Return;END;
  532.   END;
  533. END SetTextArray;
  534.  
  535. PROCEDURE  ConvertNumber (Number:CARDINAL;VAR Menu,Item,SubItem:CARDINAL);
  536. VAR  NumberBits : BITSET;   (* Menu-Ereignis auswerten *)
  537. BEGIN
  538.   NumberBits := CAST(BITSET,Number);
  539.   Menu := CAST(CARDINAL,(NumberBits*BITSET{0,1,2,3,4}));
  540.   Item := CAST(CARDINAL,(NumberBits*BITSET{5,6,7,8,9,10}));
  541.   Item := Item/32;
  542.   SubItem := CAST(CARDINAL,(NumberBits*BITSET{11,12,13,14,15}));
  543.   SubItem := SubItem/2048
  544. END  ConvertNumber;
  545.  
  546. PROCEDURE SetFlags;
  547. VAR flg:GadgetDataFlags;
  548. BEGIN
  549.   n:=CAST(LONGCARD,gdFLAGS[aktivGadget]);
  550.   IF n#FLAGS THEN (* wenn sich der Zustand der Flags gegenüber dem letzten *)
  551.     FLAGS:=n;     (* Aufruf geändert hat, dann neu darstellen *)
  552.     FOR i:=0 TO 31 DO
  553.       j:=n MOD 2;n:= n DIV 2;
  554.       flg:=VAL(GadgetDataFlags,i);
  555.       IF flg IN gdNOFLAGS[aktivGadget] THEN
  556.         Value:=ISetGadgetAttributes(glPtr,i+17,GadgetDataFlagSet{disabled},noFlag,j,curValue,NIL);
  557.       ELSE
  558.         Value:=ISetGadgetAttributes(glPtr,i+17,GadgetDataFlagSet{disabled},GadgetDataFlagSet{disabled},j,curValue,NIL);
  559.       END;
  560.     END;
  561.   END;
  562. END SetFlags;
  563.  
  564. PROCEDURE CheckInput;
  565. VAR i,j :INTEGER;
  566. BEGIN
  567.   WaitPort(WinPtr^.userPort);
  568.   IF GetIMes(WinPtr,code,value,class) THEN  (* IDCMP-Meldung holen *)
  569.     IF (closeWindow IN class) THEN
  570.       CloseAll;
  571.     ELSIF (newSize IN class) THEN
  572.       BeginRefresh(WinPtr);
  573.       IRefreshGadgets(glPtr);
  574.       EndRefresh(WinPtr,TRUE);
  575.     ELSIF ISUP=class THEN (* stammt sie von intuisup ? *)
  576.                 (* ja, ---> auswerten *)
  577.       IF code<17 THEN
  578.         aktivGadget:=code;
  579.         SetFlags; (* Zustand der Flags des angewählten Testgadgets darstellen *) 
  580.         IF code #15 THEN    
  581.           Value:=ISetGadgetAttributes(glPtr,15,noFlag,noFlag,curValue,aktivGadget,titlePtr);
  582.           (* Im ListView-Fenster die Zeile des Gadgets hervorheben, das zuletzt aktiviert wurde *)
  583.         END;
  584.       END;
  585.       CASE code OF
  586.         0:SetRequester;|      (* AutoRequester aufrufen *)
  587.         2:count:=value=1;|    (* Zähler an/aus *)
  588.         3:IFreeRenderInfo(riPtr);
  589.           gd[3].gdCheckSelected:=value;
  590.           IF value=0 THEN
  591.             riPtr:=IGetRenderInfo(NIL,RenderInfoFlagSet{innerWindow});
  592.           ELSE
  593.             riPtr:=IGetRenderInfo(NIL,RenderInfoFlagSet{innerWindow,backFill});
  594.           END;
  595.           ModifyGadgetList(1);SetFlags;|
  596.         4:language:=value;SetTextArray; (* Neue LANGUAGE-Datei öffnen *)
  597.           gd[4].gdMXActiveEntry:=value;
  598.           ModifyMenuList(1);            (* Menüs neu einrichten/anzeigen *)
  599.           ModifyGadgetList(1);          (* Gadgets neu einrichten *)
  600.           i:=ISetGadgetAttributes(glPtr,4,GadgetDataFlagSet{},GadgetDataFlagSet{},2,language,ADR(mx[0]));|
  601.         5:buf:=CAST(ADDRESS,value);     (* String entgegennehmen und in die Titelzeile setzen *)
  602.           SetWindowTitles(WinPtr,buf,NIL);|
  603.         6..7:IF code=6 THEN nr1:=value ELSE nr2:=value;END;
  604.              i:=ISetGadgetAttributes(glPtr,14,GadgetDataFlagSet{},GadgetDataFlagSet{},nr1,nr2,(nr1+nr2) DIV 2);|
  605.               (* obere/untere Grenze des Count-Gadgets neu setzen *)
  606.         12:IClearWindow(riPtr,WinPtr,518,8,24,24,clrmodus); 
  607.           IDrawBorder(riPtr,WinPtr,520,10,20,20,value+1);|  (* Rahmen zeichnen *)
  608.         13:countmode:=value;| (* Zählmodus einstellen *)
  609.         15:IClearWindow(riPtr,WinPtr,0,0,Winwidth,Winheight,clrmodus);
  610.           IRefreshGadgets(glPtr);
  611.           aktivGadget:=value;SetFlags;
  612.           FOR j:=1 TO 20 DO (* angewähltes Gadget mit flackerndem Rahmen umgeben *)
  613.             IDrawBorder(riPtr,WinPtr,bd[value].LE,bd[value].TE,bd[value].WI,bd[value].HE,1+(j MOD 4));Delay(10);
  614.           END;|
  615.         16:IF value=0 THEN BreakPoint(ADR("Breakpoint!!"));END;|    (* Funktioniert nur mit spez. Debugger *)
  616.         17:IF value=1 THEN 
  617.             Value:=ISetGadgetAttributes(glPtr,aktivGadget,GadgetDataFlagSet{disabled},GadgetDataFlagSet{disabled},curValue,curValue,curValue);
  618.             INCL(gdFLAGS[aktivGadget],disabled);
  619.            ELSE
  620.             Value:=ISetGadgetAttributes(glPtr,aktivGadget,GadgetDataFlagSet{disabled},GadgetDataFlagSet{},curValue,curValue,curValue);
  621.             EXCL(gdFLAGS[aktivGadget],disabled);
  622.            END;|
  623.         18..48:gdf:=VAL(GadgetDataFlags,code-17);
  624.                IF value=1 THEN 
  625.                   INCL(gdFLAGS[aktivGadget],gdf);
  626.                ELSE
  627.                   EXCL(gdFLAGS[aktivGadget],gdf);
  628.                END;|
  629.         49:IClearWindow(riPtr,WinPtr,0,0,Winwidth,Winheight,clrmodus);
  630.           SetTestGadgets;
  631.           Value:=ISetGadgetAttributes(glPtr,15,noFlag,noFlag,curValue,aktivGadget,titlePtr);
  632.           ModifyGadgetList(1);
  633.           FLAGS:=0;SetFlags;|
  634.         ELSE
  635.       END;
  636.       IClearWindow(riPtr,WinPtr,msgLE,msgTE,msgLE+msgWI-12,msgTE+msgHE-1,clrmodus);
  637.       i:=IConvertUnsignedDec(code,ADR(nr),ConvertFlagSet{});
  638.       buffer:="Gadget :";Concat(buffer,nr);
  639.       IF code=5 THEN
  640.         Concat(buffer,"  Text:");
  641.         buf:=CAST(ADDRESS,value);
  642.         Concat(buffer,buf^);
  643.       ELSE
  644.         i:=IConvertSignedDec(value,ADR(nr),ConvertFlagSet{});
  645.         Concat(buffer,"  Wert:");Concat(buffer,nr);
  646.       END;
  647.       i:=IPrintText(riPtr,WinPtr,ADR(buffer),0,msgTE,dtText,TextDataFlagSet{Center,Color2},NIL);
  648.       (* ^------- Gadget-Meldungen darstellen -------^ *)
  649.       (*  _______ Meldungen darstellen _____________ *)
  650.       (* |                                          | *)
  651.     ELSIF (menuPick IN class) THEN
  652.       WHILE code#65535 DO
  653.         IClearWindow(riPtr,WinPtr,msgLE,msgTE,msgLE+msgWI-12,msgTE+msgHE-1,clrmodus);
  654.         iptr:=IMenuItemAddress(mlPtr,code);
  655.         ConvertNumber(code,Menu,Item,SubItem);
  656.         i:=IConvertUnsignedDec(Menu,ADR(nr),ConvertFlagSet{});
  657.         buffer:="Menu :";Concat(buffer,nr);
  658.         i:=IConvertUnsignedDec(Item,ADR(nr),ConvertFlagSet{});
  659.         IF Item#63 THEN
  660.           Concat(buffer,"  Item :");Concat(buffer,nr);
  661.           i:=IConvertUnsignedDec(SubItem,ADR(nr),ConvertFlagSet{});
  662.           IF SubItem#31 THEN
  663.             Concat(buffer,"  SubItem :");Concat(buffer,nr);
  664.           END;
  665.         END;
  666.         IF (Menu=0) AND (Item=3) THEN CloseAll;END;
  667.         i:=IPrintText(riPtr,WinPtr,ADR(buffer),0,msgTE,dtText,TextDataFlagSet{Center,Color2},NIL);
  668.         IF iptr#NIL THEN            (* liegt noch eine Menu-Wahl vor? *)
  669.           code:=iptr^.nextSelect;
  670.           IF code#65535 THEN Delay(50);DisplayBeep(NIL);END;    (* Ja! *)
  671.         ELSE
  672.           code:=65535;
  673.         END;
  674.       END;
  675.     ELSIF (intuiTicks IN class) THEN
  676.       IF count THEN     (* zählen? *)
  677.         INC(n0);        (* ja! *)
  678.         CASE countmode OF
  679.           0:i:=IConvertSignedDec(n0,ADR(buffer),ConvertFlagSet{});|
  680.           1:i:=IConvertHex(n0,ADR(buffer),ConvertFlagSet{});|
  681.           2:i:=IConvertBin(n0,ADR(buffer),ConvertFlagSet{});|
  682.         END;
  683.         i:=IPrintText(riPtr,WinPtr,ADR(buffer),Winwidth-8,100,dtText,TextDataFlagSet{PlaceLeft,Backfill},NIL);
  684.       END;
  685.     END;
  686.   END;
  687. END CheckInput;
  688.  
  689. BEGIN
  690.   clrmodus:=ClrWindowFlagSet{};aktivGadget:=0;
  691.   entries:=92;language:=0;menuPen:=2;n0:=0;
  692.   ltaptr[0]:=ADR("Language:german.language");
  693.   ltaptr[1]:=ADR("Language:english.language");
  694.   ltaptr[2]:=ADR("Language:french.language");
  695.   SetTextArray;
  696.   IF OpenThinFont() THEN
  697.     IF BuildTestList() THEN END;
  698.     InitWindow;
  699.     SetDefaultFlags;
  700.     InitGadgets;
  701.     InitMenu;
  702.     SetFlags;
  703.     WHILE WinPtr#NIL DO
  704.       CheckInput;
  705.     END;
  706.   ELSE
  707.     CloseAll;
  708.   END;
  709. END IntuisupDemo.
  710.  
  711. (* Language:german.language *)
  712. (* Language:english.language *)
  713. (* Language:french.language *)